home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / charger.zip / CHARGER.PAS < prev   
Pascal/Delphi Source File  |  1986-05-27  |  6KB  |  257 lines

  1. CONST
  2.     SCRNMAX     = 80;
  3.  
  4. TYPE
  5.     STR80       = STRING[80];
  6.     CHARSET     = SET OF CHAR;
  7.     
  8.             {Screen Display Routines}
  9.  
  10. FUNCTION At (x,y:INTEGER):CHAR;
  11.     BEGIN
  12.         GOTOXY(x,y);
  13.         At := CHR(0)
  14.     END;
  15.  
  16. FUNCTION Bright:CHAR;
  17.     BEGIN
  18.         HIGHVIDEO;
  19.         Bright := CHR(0)
  20.     END;
  21.  
  22. FUNCTION Dim:CHAR;
  23.     BEGIN
  24.         LOWVIDEO;
  25.         Dim := CHR(0)
  26.     END;
  27.  
  28.         {Screen Erase Routines}
  29.  
  30. PROCEDURE WipeUp(t:INTEGER);
  31.     VAR
  32.         i   : BYTE;
  33.     BEGIN
  34.         FOR i := 24 DOWNTO 1 DO BEGIN
  35.             GOTOXY(1,i);
  36.             CLREOL;
  37.             DELAY(t)
  38.         END;
  39.         GOTOXY(1,1)
  40.     END;
  41.  
  42. PROCEDURE WipeDown(t:INTEGER);
  43.     VAR
  44.         i   : BYTE;
  45.     BEGIN
  46.         FOR i := 1 TO 24 DO BEGIN
  47.             GOTOXY(1,i);
  48.             CLREOL;
  49.             DELAY(t)
  50.         END;
  51.         GOTOXY(1,1)
  52.     END;
  53.  
  54. PROCEDURE Scroll(lines,time:INTEGER);
  55.     VAR
  56.         i   : BYTE;
  57.     BEGIN
  58.         FOR i := 1 TO lines DO BEGIN
  59.             WRITE(At(SCRNMAX,24),^J);
  60.             DELAY(time)
  61.         END;
  62.         GOTOXY(1,1)
  63.     END;
  64.  
  65.         {String Formatting Routines}
  66. {$V-}
  67.  
  68. FUNCTION LString(s:STR80;n:INTEGER):STR80;
  69.     BEGIN
  70.         LString := COPY(s,1,n)
  71.     END;
  72.  
  73. FUNCTION RString(s:STR80;n:INTEGER):STR80;
  74.     BEGIN
  75.         RString := COPY(s,LENGTH(s)-PRED(n),n)
  76.     END;
  77.  
  78. FUNCTION PadLeft(s:STR80;n:BYTE):STR80;
  79.     BEGIN
  80.         WHILE LENGTH(s) < n DO
  81.             s := ' ' + s;
  82.         PadLeft := s
  83.     END;
  84.  
  85. FUNCTION PadRight(s:STR80;n:BYTE):STR80;
  86.     BEGIN
  87.         WHILE LENGTH(s) < n DO
  88.             s := s + ' ';
  89.         PadRight := s
  90.     END;
  91.  
  92. {$V+}
  93.  
  94.         {Screen Output Routines}
  95. {$V-}
  96.  
  97. PROCEDURE Center(line:INTEGER; s:STR80);
  98.     BEGIN
  99.         WRITE(AT(SCRNMAX DIV 2 -(LENGTH(s) DIV 2),line),s)
  100.     END;
  101.  
  102. PROCEDURE RPrint(s:STR80; t,x,y:INTEGER);
  103.     VAR
  104.         i       : BYTE;
  105.     BEGIN
  106.         FOR i := 1 TO LENGTH(s) DO BEGIN
  107.             GOTOXY(PRED(x+i),y);
  108.             WRITE(s[i]);
  109.             DELAY(t)
  110.         END;
  111.     END;
  112.  
  113. PROCEDURE LPrint(s:STR80; t,x,y:INTEGER);
  114.     VAR
  115.         i       : BYTE;
  116.     BEGIN
  117.         FOR i := LENGTH(s) DOWNTO 1 DO BEGIN
  118.             WRITE(At(PRED(x+i),y),s[i]);
  119.             DELAY(t)
  120.         END;
  121.     END;
  122.  
  123. PROCEDURE Frame(line:BYTE; s:STR80);
  124.     VAR
  125.         i,j     : BYTE;
  126.         s1      : STR80;
  127.     BEGIN
  128.         s  := '* ' + s + ' *';
  129.         s1 := '';
  130.         FOR i := 1 TO LENGTH(s) DO
  131.             s1 := s1 + '*';
  132.         Center(line,s1);
  133.         Center(line+1,s);
  134.         Center(line+2,s1)
  135.     END;
  136.  
  137. {$V+}
  138.  
  139.         {Keyboard Input}
  140.  
  141. FUNCTION GetChar(okset:CHARSET; show:BOOLEAN):CHAR;
  142.     VAR
  143.         good        : BOOLEAN;
  144.         ch          : CHAR;
  145.     BEGIN
  146.         REPEAT
  147.             READ(KBD,ch);
  148.             IF EOLN(KBD) THEN ch := ^M;
  149.             good := ch IN okset;
  150.             IF NOT good THEN WRITE(^G)
  151.                         ELSE
  152.                             IF show THEN
  153.                                 IF ch IN [CHR(32)..CHR(126)] THEN WRITE (ch);
  154.         UNTIL good;
  155.         GetChar := ch
  156.     END;
  157.  
  158. FUNCTION GetString(okset:CHARSET; maxlen:INTEGER):STR80;
  159.     VAR
  160.         s1,stemp    : STR80;
  161.         i,n         : BYTE;
  162.     BEGIN
  163.         s1 := ''; stemp := '';
  164.         REPEAT
  165.             IF LENGTH(stemp) = 0
  166.                 THEN
  167.                     s1[1] := GetChar(okset + [^M],TRUE)
  168.                 ELSE
  169.                     IF LENGTH(stemp) = maxlen
  170.                         THEN
  171.                             s1 := GetChar([^M,^H,^X],TRUE)
  172.                         ELSE
  173.                             s1 := GetChar(okset + [^M,^H,^X],TRUE);
  174.             IF s1[1] in okset
  175.                 THEN
  176.                     stemp := s1[1]
  177.                 ELSE
  178.                     IF s1[1] = ^H  {DESTRUCTIVE BACKSPACE}
  179.                         THEN BEGIN
  180.                             WRITE(^H,' ',^H);
  181.                             DELETE(stemp,LENGTH(stemp),1)
  182.                         END;
  183.                     IF s1[1] = ^X  {CANCEL LINE}
  184.                         THEN BEGIN
  185.                             FOR i := 1 TO LENGTH(stemp) DO
  186.                                 WRITE(^H,' ',^H);
  187.                             s1    := '';
  188.                             stemp := '';
  189.                         END;
  190.         UNTIL s1[1] = ^M;
  191.         IF LENGTH (stemp) <> 0
  192.             THEN
  193.                 GetString := stemp
  194.             ELSE
  195.                 GetString := ''
  196.     END;
  197.     
  198.             {Menu Selection Routines}
  199.  
  200. PROCEDURE Pointer(VAR cp:INTEGER; max,horiz,vert:INTEGER);
  201.     VAR
  202.         cpo     : INTEGER;
  203.         ch      : CHAR;
  204.     BEGIN
  205.         cp      := PRED(cp);
  206.         cpo     := cp;
  207.         max     := PRED(max);
  208.         WRITE(AT(horiz-1,vert+cp),Bright,'>',Dim);
  209.         REPEAT {MAIN LOOP}
  210.             REPEAT {READ KEYBOARD}
  211.                 ch := CHR(0);
  212.                 READ(KBD,ch)
  213.             UNTIL (ORD(ch) IN [45,13,43,27]);
  214.             WRITE(At(horiz-1,vert+cp),'   ');
  215.             IF (ch = CHR(45) ) THEN
  216.                 BEGIN {MINUS SIGN}
  217.                     cp := PRED(cp);
  218.                     IF cp < 0 THEN cp := max
  219.                 END;
  220.             IF (ch = chr(43)) THEN
  221.                 BEGIN {PLUS SIGN}
  222.                     cp := SUCC(cp);
  223.                     IF cp > max THEN cp := 0
  224.                 END;
  225.             WRITE(At(horiz-1,vert+cp),Bright,'>',Dim);
  226.         UNTIL (ch IN [CHR(13),CHR(27)]);
  227.         IF (ch = chr(27)) THEN cp := cpo;
  228.         cp := SUCC(cp)
  229.     END;
  230.  
  231. {$V-}
  232. FUNCTION Letter(s:STR80):CHAR;
  233.     VAR
  234.         s1      : STR80;
  235.     BEGIN
  236.         s1 := COPY(s,1,1);
  237.         DELETE (s,1,1);
  238.         WRITE(Bright,s1,Dim,')',s);
  239.         Letter := CHR(0)
  240.     END;
  241.  
  242. FUNCTION Choices(s:STR80):CHAR;
  243.     VAR
  244.         i       : BYTE;
  245.     BEGIN
  246.         WRITE(Dim,'Please select: ');
  247.         FOR i := 1 TO LENGTH(s) DO
  248.             WRITE(Bright,S[i],Dim,') ');
  249.         Choices := CHR(0)
  250.     END;
  251. {$V-}
  252.                     
  253.         
  254.             
  255.  
  256.     
  257.